;tentative de creation d'une machine vituelle
;donc la aussi je sais pas ce que je fais
;par contre vu que je sais pas ce que ca doit renvoyer c'est plus problematique
;ya un chapitre dans le cours qui en parle (et un td), je m'en suis inspire

;p.56 il y a un tableau avec des fonctions de la vm
;je crois qu'il faut toutes les implementer
;(load "/auto_home/dvaret/workspace/LispProjet/makevm.lisp")

(defun makevm (vm)
  (progn
    (setregister vm)
    (setmemory vm)
    vm
    ))

;pour creer des registres (pas sur que ca marche)
(defun setregister (vm)
  (progn
    ;registres generaux (p55 poly)
    (setf (get vm 'name) vm)
    (setf (get vm 'R0) 5)
    (setf (get vm 'R1) 3)
    (setf (get vm 'R2) 0)
    (setf (get vm 'R3) 0)
    (setf (get vm 'R4) 0)
    (setf (get vm 'R5) 0)
    (setf (get vm 'R6) 0)
    (setf (get vm 'R7) 0)
    ;registres dedies
    (setf (get vm 'BP) 0) ;base pointer (a priori on ne touchera jamais a ce registre)
    (setf (get vm 'SP) 0) ;stack pointer
    (setf (get vm 'PC) 0) ;program counter
    
    (setf (get vm 'FP) 0) ;frame pointer (?)
    ;registres booleens (flags)
    (setf (get vm 'FLT) 0) ;plus petit
    (setf (get vm 'FEQ) 0) ;egal
    (setf (get vm 'FGT) 0) ;plus grand
    vm
    ))

;pour creer de la memoire (sous forme d'un tableau d'elements)
;la fonction c'est
;make-array nb_elements &optionnel premier_element
(defun setmemory (vm)
  (progn
    (setf (get vm 'memory) (make-array 1000))
    vm
    ))

;;;;INSTRUCTIONS

;;Acces memoire
;de memoire a registre
(defun vmload (vm src dest) 
  (setf (get vm dest) (aref (get vm 'memory) (get vm src))))
;de registre a memoire
(defun vmstore (vm src dest)
  (let ((val (get vm src)))
    (if (numberp src)
        (setf (aref (get vm 'memory) dest) src)
        (setf (aref (get vm 'memory) (get vm dest)) val))))
;de registre a registre
(defun vmmove (vm src dest)
  (let ((val (get vm src)))
    (if (numberp src)
        (setf (get vm dest) src)
        (setf (get vm dest) val))))

;;Instructions arithmetiques
;addition
(defun vmadd (vm src dest)
  (let ((v1 (get vm src)) (v2 (get vm dest)))
    (setf (get vm dest) (+ v1 v2))))
;soustraction
(defun vmsub (vm src dest)
  (let ((v1 (get vm src)) (v2 (get vm dest)))
    (setf (get vm dest) (- v1 v2))))
;multiplication
(defun vmmul (vm src dest)
  (let ((v1 (get vm src)) (v2 (get vm dest)))
    (setf (get vm dest) (* v1 v2))))
;division
(defun vmdiv (vm src dest)
  (let ((v1 (get vm src)) (v2 (get vm dest)))
    (setf (get vm dest) (/ v1 v2))))
;increment
(defun vmincr (vm dest)
  (let ((v1 (get vm dest)))
    (setf (get vm dest) (+ v1 1))))
;decrement
(defun vmdecr (vm dest)
  (let ((v1 (get vm dest)))
    (setf (get vm dest) (- v1 1))))

;;Instructions de pile
;empiler
(defun vmpush (vm src)
  (vmincr vm 'SP)
  (vmstore vm src 'SP)
  )
  
;depiler
(defun vmpop (vm dest)
  (vmload vm 'SP dest)
  (vmdecr vm 'SP)
  )

;;Etiquettes
;declaration
(defun label (vm label)
  ())
;saut inconditionnel a une etiquette
(defun jmp (vm label)
  (setf (get vm 'PC) (get vm label))
  (vmmove vm label 'PC))


;;Saut avec retour
(defun jsr (label)
  ())
;retour
(defun rtn ()
  ())

;;Comparaison // Sauts conditionnels
;comp
(defun cmp (vm src1 src2)
  (cond 
    (((get vm src1) < (get vm src2))
     (vmincr vm 'FLT))
    (((get vm src1) > (get vm src2))
     (vmincr vm 'FGT))
    (((get vm scr1) = (get vm src2))
     (vmincr vm 'FEG))))
     
;sauts
;si plus grand
(defun jgt (label)
  ())
;si plus grand ou egal
(defun jge (label)
  ())
;si plus petit
(defun jlt (label)
  ())
;si plus petit ou egal
(defun jle (label)
  ())
;si egal
(defun jeq (label)
  ())
;si different
(defun jne (label)
  ())

;;Gestion de NIL
;comp a NIL
(defun test (src)
  ())
;saut si non nil
(defun jtrue (label)
  ())
;saut si nil
(defun jnil (label)
  ())

;Divers
;rien
(defun nop ()
  ())
;arret
(defun halt ()
  ())